% These things by JDH might give material for Appendix D, or exercises

% Here's a beaut: one can call inorder(a,b,c), for example!
% See if a list of at least two numerics, strings, or pairs is in order.

def inorder(expr s)(text t) =
    ((s  for i:=t: <=i) and (i endfor  >= s))
enddef;
% comment by DEK: the last >=s could be replaced by "tautology 0"
% where x tautology y = true

% Argument is a list of at least two numeric or pair expressions.

def equally_spaced(expr s)(text t) =
    begingroup save dD;
    if pair s: pair dD; fi
    s  for i:=t: -i=i endfor -dD;
    endgroup
enddef;


% Draw a grid with vertical lines at all the positions in xlist and horizontal
% lines at all the positions in ylist.  Both xlist and ylist can either be
% explicit lists of point numbers or `thru' constructs.
%    The calling syntax should be `grid(...)(...)' exactly as if there were two
% text parameters.  The tricky `fingrid' routine parses the other parameter
% and uses the x-list stored in the `xxl' array.  This allows expr parameters
% of other macros to appear in both lists.
% (The strange capitalizations reduce the chance of name conflict.)

def grid(text xlist) =
    begingroup save xmiN, xmaX, ymiN, ymaX, xXl, xXllng;
    xXllng:=0;
    for i:=xlist: xXl[incr(xXllng)] = i; endfor
    xmiN = min(xlist);
    xmaX = max(xlist);
    fingrid
enddef;

def fingrid(text ylist) =
    ymiN = min(ylist);
    ymaX = max(ylist);
    for i:=1 thru xXllng: proofrule((xXl[i],ymiN), (xXl[i],ymaX)); endfor
    for i:=ylist: proofrule((xmiN,i), (xmaX,i)); endfor
    endgroup
enddef;

% Window allocation

% We allocate windows 1, 2, ..., 15.  Window 0 is perminantly reserved for
% other uses.
% The window allocation routines treat the screen as an infinite rectangle
% screencols pixels wide.  Windows are sequentially allocated in rows.  All
% windows in a row are lined up at their top edge at the height of the lowest
% bottom edge in the previous row.
% To do this allocation we maintain the screen coordinate pair screencorner, where
% the upper-left corner of the next window will be if it fits on the row.  We
% also maintain screenbot, the height of the next row if any.

nwindows = 0;
pair screen_corner; screen_corner=(0,0);% upper left corner of space for next window
screen_bot = 0;				% vertical pos for next row of windows

def wipescreen =
    for i:=1 thru nwindows: display blankpicture on i; endfor
    nwindows := 0;
    screen_corner := origin
enddef;


% Given the MF coordinates of any two opposite corners of a rectangle, map that
% rectangle to the next available screen rectangle and open it as window number
% window@#.

vardef newwindow@#(expr a, b) =
    %begingroup
    save uplft, lowrt;
    pair uplft, lowrt;
    if showing:
      if nwindows=15: errmessage "No more windows left!";
      else: window@#:=incr(nwindows);
	    uplft = (min(xpart a,xpart b), max(ypart a,ypart b));
	    lowrt = (a + b - 2uplft) rotated 90;                  % screen coordinates
	    if ypart(screen_corner+lowrt) > screencols:
		screen_corner := (screenbot,0);
	    fi;
	    openwindow window@# from screen_corner to screen_corner+lowrt
		       at uplft;
	    screen_bot := max(screen_bot, xpart(screen_corner+lowrt));
	    screen_corner := screen_corner + (0, ypart lowrt);
      fi
    fi
    %endgroup
enddef;

% Here is a routine very much like draw except that the stuff after it has to
% be enclosed in parentheses and it shouldn't execute any other drawing
% commands.  (That is rather unlikely anyway.)
% The difference is that the ends are cut off flush.  The cut line is defined
% by the points where the pen is tangent to the envelope at either end of the
% path, where tangents to the envelope are given by the version of penoffset
% defined above.  The angle of the cut should be exactly right for circular
% pens when the terminal directions are multiples of 45 degrees (if DEK would
% change make_pen to guarantee the symmetry of circular pens), but may
% sometimes stray significantly from the ideal value.  Anything much fancier
% would require extrapolating the path and would be of questionable value for
% non-circular pens.

let normalwithpen = withpen;
let normalwithweight = withweight;

def drawflush(text spec) =
    begingroup save ptH, peN, wT, lL;	% strange names to avoid conflict
    pen peN; path ptH;
    peN = defaultpen;
    wT = 1;
	def withpen = ;peN := enddef;
	def withweight = ;wT := enddef;
	ptH = spec;
	let withpen = normalwithpen;
	let withweight = normalwithweight;
    lL = length ptH;
    draw ptH withpen peN;
    erase_end(point lL of ptH, -direction lL of ptH, peN, wT);
    erase_end(point 0 of ptH, direction 0 of ptH, peN, wT);
    endgroup
enddef;

% This is a little trickey but it just sets the default weight to -1.

def undrawflush(text spec) =
    drawflush(origin withweight -1; ptH:= spec)
enddef;


% Erase the end of pen pn assuming that it starts at point p in direction d
% and was drawn with weight wt.

def erase_end(expr p, d, pn, wt) =
    begingroup
    save e, x, y, u;
    path u;			% path enclosing everything done to e
    edges e;			% edges to be subtracted from the current picture
    interim smoothing:=0;
    interim autorounding:=0;
    e := nulledges;
    addto e doublepath p withpen pn;		% now e contains a pen image
    z0 = p + Penoffset d of pn;
    z2 = p + penoffset d rotated 90 of pn;
    z4 = p + Penoffset -d of pn;
    z6 = p + penoffset d rotated -90 of pn;
    parallelto(d, 0,1,7);
    parallelto(d, 3,4,5);
    perpto(d, 1,2,3);
    perpto(d, 5,6,7);
    addto e contour z0~..z1~..z3~..z4~..cycle withweight -1;
    cull e by (-4095,1);			% now e is part of pen to be removed
    if wt>0:
	u = z1~..z3~..z5~..z7~..cycle;
	addto e contour u withweight -1;	% wts: bad pix 0, others in u -1
	cull e by (-1,4095);			% wts: bad pix 0, others in u 1
	addto e contour u withweight -1;	% wts: bad pix -1, all others 0
    fi
    for i:=1 thru abs round wt: addto currentpicture also e; endfor
    endgroup
enddef;

def =: = getexp 0; getsuf enddef;
tertiarydef e getexp garbage =
    begingroup save savE; pair savE; savE=e
enddef;
vardef getsuf.z@# =
    x@#:=xpart savE; y@#:=ypart savE; endgroup
enddef;

% A boolean test of the form `if p or q: P', where q cannot be safely
% evaluated when p is true cannot be easily be performed with if...else
% without repeating P.  The following macros get around this at the cost
% of having to put extra parentheses around the second argument.
% e.g. if p cor(q): P ...; similarly, if p cand(q): ...

primarydef p startif garbage = if p: enddef;

def cand(text q) = startif true q else: false fi enddef;

def cor(text q) = startif true true else: q fi enddef;

% Generalized equality test
tertiarydef a == b =
if numeric a or string a or pair a: (a=b)
elseif boolean a: (a and b or not (a or b))
elseif transform a:
    (true
     for i:=N,E,origin: and (i transformed a = i transformed b) endfor)
elseif path a:
    if (cycle a == cycle b) and (length a = length b)
       and (point 0 of a = point 0 of b):
	    begingroup save t; boolean t;
	    t=true;
	    for i:=1 thru length a:
		t:=(point i of a = point i of b) and
		   (precontrol i of a = precontrol i of b) and
		   (postcontrol i-1 of a = postcontrol i-1 of b);
		exitunless t;
	    endfor
	    t endgroup
     else: false
    fi
elseif pen a: (makepath a == makepath b)
else: errmessage "I can't compare edges.  Ask DEK"
fi
enddef;